home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
wedits22.zip
/
WEDICT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-17
|
11KB
|
402 lines
UNIT WEDict; {$O+}
{ -- Dictionary module for WWIVEdit 2.2
-- Last Updated 8/15/91
-- Written by:
-- Adam Caldwell
--
-- This code is limited public domain (see WWIVEDIT.PAS for more details
--
-- Purpose: Provide a spell checker for WWIVEdit 2.2
--
-- Known Errors: None
--
-- Planned Enhancements:
-- Data Compression on dictionary
-- }
{$R-,V-,S+,B-,E-,N-} { These Optomize things as much as possible }
INTERFACE
PROCEDURE SpellCheck;
IMPLEMENTATION
USES WEVars, WEMisc, WEString, WELine, WEKbd, WEInput, WEOutput, WETime;
TYPE
Index=ARRAY[0..27,0..27] OF LongInt;
WordRec=RECORD
Next : LongInt;
Word : String[25];
END;
VAR
ind :index;
f:file;
DictionaryIndexLoaded : boolean;
posi : longint;
FUNCTION CheckSpelling(s:string):boolean;
VAR
w:wordrec;
b1,b2 : byte;
p : longint;
s1 : string;
BEGIN
b1:=ord(s[1])-ord('a')+1;
b2:=ord(s[2])-ord('a')+1;
IF length(s)=1 THEN b2:=0;
IF b1>26 THEN b1:=27;
IF b2>26 THEN b2:=27;
p:=ind[b1,b2];
s1:='';
WHILE (p<>0) AND (s<>s1) DO
BEGIN
seek(f,p);
{$I-} blockread(f,w,Sizeof(wordRec)); {$I+}
IF IOResult<>0 THEN ;
p:=w.next;
s1:=w.word;
END;
CheckSpelling:=s=s1;
END;
PROCEDURE CloseDictionary;
BEGIN
IF DicChanged THEN BEGIN
seek(f,0);
blockwrite(f,ind,sizeof(index));
END;
close(f);
END;
PROCEDURE OpenDictionary;
BEGIN
posi:=0;
DictionaryIndexLoaded:=FALSE;
DicChanged:=FALSE;
assign(f,StartupDir+'SPELL.DAT');
reset(f,1);
IF NOT DictionaryIndexLoaded THEN
BlockRead(f,ind,sizeof(ind));
DictionaryIndexLoaded:=True;
END;
FUNCTION Suggest(s:string; VAR startat:integer; newword:boolean):boolean;
VAR
b1, b2 :byte;
w : wordrec;
i : integer;
weight : longint;
s1, s2 : string;
BEGIN
IF (newword) THEN BEGIN
b1:=ord(s[1])-ord('a')+1;
b2:=ord(s[2])-ord('a')+1;
IF length(s)=1 THEN b2:=0;
IF b1>26 THEN b1:=27;
IF b2>26 THEN b2:=27;
posi:=ind[b1,b2];
END;
seek(f,posi);
{$I-} blockread(f,w,sizeof(wordrec)); {$I+}
IF IOResult=0 THEN ;
weight:=0;
s1:=w.word;
FOR i:=1 TO Length(s) DO
IF (pos(s[i],s1)>0) AND (abs(pos(s[i],s1)-i+weight)<3) THEN
BEGIN
delete(s1,pos(s[i],s1),1);
inc(weight);
END;
weight:=0;
s2:=s;
FOR i:=1 TO Length(w.word) DO
IF (pos(w.word[i],s2)>0) AND (abs(pos(w.word[i],s2)-i+weight)<3) THEN
BEGIN
delete(s2,pos(w.word[i],s2),1);
inc(weight);
END;
IF ((pos(s1,w.word)+length(s1)-1=length(w.word)) OR (length(s1)<length(s) div 2)) AND
((w.word+s2=s ) OR (length(s2)<length(s) div 2)) AND
(abs(length(w.word)-length(s))<length(s1) div 2 + 2) THEN
BEGIN
inc(startat);
Suggestion[startat]:=w.word;
END;
posi:=w.next;
suggest:=posi<>0;
END;
PROCEDURE AddChainPointer(n:longint);
VAR
w : wordrec;
p : longint;
BEGIN
p:=n;
WHILE p<>0 DO
BEGIN
n := p;
seek(f,p);
BlockRead(f,p,sizeof(longint));
END;
seek(f,n);
p:=FileSize(f);
BlockWrite(f,p,sizeof(longint));
Seek(f,FileSize(f));
END;
PROCEDURE AddWord(s:string);
VAR
b1, b2 : byte;
w:wordrec;
BEGIN
DicChanged:=TRUE;
b1:=ord(s[1])-ord('a')+1;
b2:=ord(s[2])-ord('a')+1;
IF length(s)=1 THEN b2:=0;
IF b1>26 THEN b1:=27;
IF b2>26 THEN b2:=27;
IF ind[b1,b2]=0 THEN
BEGIN
Ind[b1,b2]:=FileSize(f);
seek(f,FileSize(f));
END
ELSE
AddChainPointer(Ind[b1,b2]);
w.Word:=s;
w.next:=0;
BlockWrite(f,w.next,1+sizeof(longint)+ord(w.word[0]));
END;
FUNCTION Clean(s:string):string;
{ -- Remove extraneous characters from string (replace them by blanks) -- }
VAR
i:integer;
BEGIN
FOR i:=1 TO length(s) DO
IF s[i] IN ['A'..'Z'] THEN
s[i]:=chr(ord(s[i])+32)
ELSE IF pos(s[i],'-~`!@#$%^&*()_+|\=1234567890{}[]:";<>?,./'+
^A^B^C^D^E^F^G^H^I^K^L^N^O^P^Q^R^S^T^U^V^W^X^Y^Z)>0
THEN s[i]:=' ';
Clean:=s;
END;
PROCEDURE SpellCheck;
{ Do the job of spell checking... What a pain... :-) }
VAR
f : file;
l, i, d, n : integer;
s, s1 : string;
px, py, sx, sy, p : byte;
ch : char;
wt,wb,vt,vb,scy : integer;
nsug : integer;
plural : String[1];
lastsug : integer;
Fun:EdFun;
more : boolean;
Temp : LineType;
LineChanged : Boolean;
lt:LongInt;
BEGIN
{ -- Initialize Variables, Save Window State, Open Dictionary -- }
wt:=WindowTop; wb:=WindowBottom;
vt:=ViewTop; vb:=ViewBottom; scy:=cy;
WindowTop:=3; WindowBottom:=WindowTop+3;
WindowHeight:=WindowBottom-WindowTop;
ViewTop:=1; ViewBottom:=ViewTop+WindowHeight;
l:=1; ch := ' ';
n:=1; cy:=1; cx:=1; lt:=0;
FOR i:=1 TO MaxPhyLines DO
InitLine(Screen[i]);
OpenDictionary;
{ -- Setup New display -- }
clrscr;
print(C2+'Spell Checking');
print(C0+dup('=',79));
for i:=1 TO WindowHeight+1 DO
nl;
print(dup('=',79));
{ -- Start Spell Checking -- }
WHILE (l<Highline) AND (n<>4) AND (NOT CheckAbort) DO
BEGIN
cx:=1; cy:=l;
s:=Clean(Line[l]^.l);
WHILE (cx<Length(s)) AND (n<>4) DO
BEGIN
s1:=copy(s,cx,length(s)-cx+1);
p:=pos(' ',s1);
WHILE (p>0) AND (cx<length(s)) AND (p<2) DO
BEGIN
inc(cx);
s1:=copy(s,cx,length(s)-cx+1);
p:=pos(' ',s1);
END;
IF p=0 THEN p:=length(s)-cx+2;
s1:=copy(s,cx,p-1);
IF length(s1)>1 THEN
BEGIN
cy:=l;
IF (cy>ViewBottom) OR (cy<viewTop) THEN BEGIN
ViewTop:=cy-1;
IF cy=1 THEN ViewTop:=1;
ViewBottom:=ViewTop+WindowHeight;
END;
IF Timer-Lt>2 THEN BEGIN
redisplay;
lt:=timer;
END;
IF NOT CheckSpelling(s1) THEN
BEGIN
AfterNext:=ClrStatLine2;
Redisplay;
px:=Wherex; py:=Wherey;
Ansic('0');
ReverseVideoOn;
prompt(copy(Line[cy]^.l,cx,length(s1)));
ReverseVideoOff;
lastsug:=4;
Suggestion[2]:='<Edit>';
Suggestion[1]:='<Ignore>';
Suggestion[3]:='<Add>';
Suggestion[4]:='<Quit>';
nsug:=4;
more := Suggest(s1,nsug,true);
n:=1;
FOR i:=1 TO nsug DO
BEGIN
IF i=n THEN ansic('4');
gotoxy(20*((i-1) mod 4)+1,(i-1) div 4+WindowBottom+3);
write(Suggestion[i]);
IF i=n THEN ansic('0');
END;
REPEAT
WHILE more AND NOT Keypressed DO
BEGIN
more:=Suggest(s1,nsug,false);
IF (more) AND (nsug>lastsug) THEN BEGIN
ansic('0');
gotoxy(20*((nsug-1) mod 4)+1,(nsug-1) div 4+WindowBottom+3);
write(Suggestion[nsug]);
lastsug:=nsug;
END;
gotoxy(20*((n-1) mod 4)+1,(n-1) div 4+WindowBottom+3);
END;
IF (NOT More) AND (nsug=4) THEN BEGIN
gotoxy(1,4+windowbottom);
prompt(C2+'No suggested spellings.');
END ELSE IF (NOT More) AND (LastSug>0) THEN BEGIN
gotoxy(20*(nsug mod 4)+1,nsug div 4+windowbottom+3);
prompt(C2+'End of Suggestions');
LastSug:=0;
END;
gotoxy(20*((n-1) mod 4)+1,(n-1) div 4+WindowBottom+3);
fun:=GetArrow;
IF fun IN [Up,Down,Left,Right] THEN
BEGIN
ansic('0');
write(Suggestion[n]);
CASE fun OF
Up : Dec(n,4);
Down : Inc(n,4);
Left : Dec(n);
Right: Inc(n);
END;
IF n<1 THEN n:=n+Nsug
ELSE IF n>Nsug THEN n:=n-NSug;
gotoxy(20*((n-1) mod 4)+1,(n-1) div 4+WindowBottom+3);
ansic('4');
write(suggestion[n]);
gotoxy(20*((n-1) mod 4)+1,(n-1) div 4+WindowBottom+3);
END;
UNTIL Fun IN [Enter];
IF (n=3) AND ((thisuser.sl>addsl) OR Local) THEN
AddWord(s1)
ELSE IF (n=3) THEN BEGIN
write(^G);
gotoxy(1,ScreenHeight-2);
Prompt(C2+'Insufficient priviledge. Sorry...');
END;
IF n<>4 THEN
BEGIN
ansic('0');
FOR i:=-1 TO nsug DIV 4 +1 DO
BEGIN
gotoxy(1,i + windowbottom+3);
clreol;
END;
gotoxy(px,py);
ansic('0');
prompt(copy(Line[cy]^.l,cx,length(s1)));
END;
IF n=2 THEN BEGIN
gotoxy(1,windowbottom+4);
print(C2+'Enter new spelling, <ENTER>=Ignore');
prompt(C4+dup(' ',20)+#27'[20D');
{$V-}
input(Suggestion[nsug+1],20);
{$V+}
IF suggestion[nsug+1]<>'' THEN n:=nsug+1 ELSE n:=1;
ansic('0');
gotoxy(1,windowbottom+4);
clreol;
gotoxy(1,windowbottom+5);
clreol;
END;
IF n>4 THEN BEGIN
Line[0]^.HardCR:=Line[cy]^.HardCR;
Line[0]^.l:=copy(Line[cy]^.l,cx,len(cy)-cx+1);
Line[0]^.c:=copy(Line[cy]^.c,cx,len(cy)-cx+1);
LDelete(cy,cx,len(cy)-cx+1);
Line[cy]^.HardCR:=FALSE;
ch:=Line[0]^.c[1]; { save color of first deleted character }
Ldelete(0,1,length(s1));
IF len(0)+length(suggestion[n])>LineLen THEN BEGIN
InsertLine(cy+1,Line[0]^);
InitLine(Line[0]^);
Temp.HardCR:=FALSE;
END;
Temp.l:=Suggestion[n];
Temp.c:=dup(ch,length(suggestion[n]));
LInsert(Temp,0,1);
InsertLine(cy+1,Line[0]^);
IF cx=1
THEN DeleteLine(cy)
ELSE Reformat(cy,true);
Redisplay;
s:=Clean(Line[cy]^.l);
IF (length(suggestion[n])<>length(s1)) AND (n<>nsug+1) THEN
cx:=cx-length(s1)+length(suggestion[n])
END;
END;
END;
IF (n<>nsug+1) THEN
cx:=cx+p
ELSE n:=1;
END;
inc(l);
END;
{ -- Close Dictionary, restore Window, Force Redisplay -- }
CloseDictionary;
windowtop:=wt; windowbottom:=wb; windowheight:=wb-wt;
IF cy=scy THEN
BEGIN
ViewTop:=vt;
ViewBottom:=vb;
END ELSE ViewTop:=cy-2;
IF ViewTop<1 THEN ViewTop:=1;
ViewBottom:=ViewTop+WindowHeight;
BeforeNext:=DoNothing;
AfterNext:=DoNothing;
ForcedRedisplay;
END;
END.